home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / BASIC / 2789.ZIP / M4TEST.BAS < prev    next >
BASIC Source File  |  1991-09-28  |  10KB  |  261 lines
  1. DECLARE SUB Monocheck ()
  2.  
  3. '/TEST PROGRAM FOR MENU 4 + POPHELP.
  4. ' Note that INCLUDEd files and help text file MENU4.HLP must be
  5. ' available in the default drive/directory. The directory containing
  6. ' INCLUDE files may be specified via the Options/Set Paths... menu.
  7. ' If you want the program to look for MENU4.HLP in a directory other
  8. ' the default, find helpath$ below and change it's assignment/
  9.  
  10. '$INCLUDE: 'MENU4DCL.BI'      '/FUNCTION declarations needed for Menu4/
  11.  
  12. DEFINT A-Z                    '/default for this module/
  13.  
  14. '/dimension arrays to hold main and submenu selections, quick
  15. ' keys and help page pointers. DIM to the number of main menu
  16. ' entries and number of longest submenu entries PLUS 1. This
  17. ' menu implementation has five main menu entries and the longest
  18. ' submenu has 12/
  19.  
  20. DIM menu$(1 TO 6, 1 TO 13)    '/main & submenu selections/
  21. DIM qkey(1 TO 6, 1 TO 13)     '/quick key selections/
  22. DIM query$(1 TO 6, 1 TO 13)   '/query$ is used to hold uppercase letters in
  23.                               ' the range A-Z. These control the context
  24.                               ' sensitivity of Pophelp when it is called
  25.                               ' from within an open menu. The letters are
  26.                               ' coded in the DATA statements also used to
  27.                               ' define menu entries and quick key selections.
  28.                               ' See manual QUICKREF.DOC and study the DATA
  29.                               ' statements at the end of this Module/
  30.  
  31. DIM spectrum(16)              '/spectrum(0..5) holds menus colours.
  32.                               ' spectrum(8..11) holds Pophelp colours.
  33.                               ' Study SUB Monocheck/
  34.  
  35.   menuentries = 5             '/5 main menu selections this implementation.
  36.                               ' Make sure you define the number of main menu
  37.                               ' entries before you call up the following
  38.                               ' INCLUDE file/
  39.  
  40. '$INCLUDE: 'MENU34.BI'        '/call up a routine to fill menu$(), qkey()
  41.                               ' and query$() from DATA statements/
  42.  
  43. '/go set colours according to monitor in use/
  44.  
  45.   CALL Monocheck              '/not a quick library subroutine/
  46.  
  47. '/finish menu initialisation. M4Init also draws the main menu
  48. ' bar along screen row 1/
  49.  
  50.   CALL M4Init(menuentries, menu$(), spectrum())
  51.  
  52.  
  53. '**********************************************************************
  54. '/This section of code (between the asterisks) is included for
  55. ' demonstration purposes only and may be deleted without
  56. ' affecting the operation of the Menus or Pophelp/
  57.  
  58. '/Fill screen with test background/
  59.  
  60.   LOCATE 2, 1
  61.   CALL clrbox(spectrum(12), 80, 23)   '/see manual QUICKREF.DOC for details/
  62.  
  63. '/do prompt line/
  64.  
  65.   COLOR spectrum(13), spectrum(14)
  66.   LOCATE 25, 1
  67.   PRINT "   Menu4 + Pophelp  "; CHR$(179);
  68.   PRINT "    F10 to Open Menu    F1 to call Help    Alt+X to Exit   ";
  69. '**************************************************************************
  70.  
  71. '/going to use Pophelp so we need to intialise/
  72.  
  73.   code$ = "08125414"    '/Pophelp will pop up screen row 08, column 12
  74.                         ' with a page size (including border) 54 columns
  75.                         ' wide and 14 rows deep/
  76.  
  77.   context$ = "X"        '/if we call Pophelp from outside the menu (i.e.
  78.                         ' from this module) it will pop up displaying the
  79.                         ' index. X,Y & Z mean special things to Pophelp.
  80.                         ' see manual for details/
  81.  
  82.   helpath$ = "MENU4.HLP"            '/tell Pophelp where it can find
  83.                                     ' the help text file/
  84.  
  85.   CALL HelpInit(helpath$)             '/pass Pophelp the
  86.   CALL Popcode(code$, spectrum())     ' information it needs/
  87.  
  88. '/miscellaneous variables/
  89.  
  90.   sh = 1                '/turn shadows on. sh = 0 turns them off/
  91.   null$ = CHR$(0)       '/need for processing Function & Alt keys/
  92.  
  93. '**********************************************************************
  94. '/Ready to go. Wait for call to display Menu4 or Pophelp Index or Quit/
  95. '**********************************************************************
  96.  
  97.   DO
  98.     DO
  99.       sel$ = INKEY$
  100.     LOOP WHILE sel$ = ""      '/wait for keypress/
  101.    
  102.     SELECT CASE sel$
  103.        
  104.     CASE null$ + CHR$(68)     '/F10 key calls menus/
  105.  
  106. '/open the menu/
  107.    
  108.     CALL M4Open(menu$(), qkey(), query$(), spectrum(), sh)
  109.  
  110. '/the menu will now remain open until the user either dismisses it
  111. ' (presses the Esc key) or makes a selection either by pressing
  112. ' Return or a highlighted quick key. If Esc is pressed the menu will
  113. ' be dismissed (closed) before control returns to here. If a selection
  114. ' is made the menu will be left on screen until you close it (by calling
  115. ' M4Close). You may want to display a dialog box or something before
  116. ' closing the menu/
  117.  
  118. '/Display returned selections (if any). Getkey4 returns the ASCII code
  119. ' of the last key pressed (if it was Esc or Return) or if a menu
  120. ' selection was made Getkey4 returns 13, the ASCII code for Return.
  121. ' Getmain4 and Getsub4 return integer numbers corresponding to the menu$()
  122. ' array co-ordinates of the selected menu entries. Use as shown below.
  123.    
  124.     IF Getkey4 = 13 THEN                '/a selection was made/
  125.  
  126.       x = Getmain4                      '/co-ordinates for main and
  127.       y = Getsub4                       ' submenu selections, which
  128.                                         ' will be retrieved from menu$()/
  129.  
  130.       COLOR spectrum(13), spectrum(14)
  131.       LOCATE 22, 3: PRINT " Your last menu selection was:    ";
  132.       LOCATE 23, 3: PRINT SPACE$(34)
  133.       LOCATE 23, 4
  134.       PRINT RTRIM$(menu$(1, x)); " + "; menu$(x + 1, y)  '/display selections/
  135.      
  136. '/if "Call POPHELP Index" was the selection then display Pophelp/
  137.  
  138.       IF menu$(x + 1, y) = "Call POPHELP Index" THEN
  139.         CALL Pophelp(context$, sh)
  140.       END IF
  141.  
  142. '/finished with the menu so dismiss it. It is only necessary to dismiss
  143. ' the menu if a selection was made/
  144.      
  145.       CALL M4Close(menu$())       '/dismiss menus/
  146.     END IF
  147.  
  148.     CASE null$ + CHR$(45)         '/Alt + X to terminate program/
  149.     EXIT DO
  150.    
  151.     CASE null$ + CHR$(59)         '/F1 key also calls Pophelp from here/
  152.     CALL Pophelp("A", sh)         '/open Pophelp & display page A/
  153.  
  154.  
  155.     END SELECT
  156.  
  157.   LOOP
  158.  
  159. '************************
  160. '/DATA statements follow/
  161. '************************
  162.  
  163. '/Main menu selections/
  164. '/Use trailing spaces to format your entries along the main menu bar.
  165. ' It's up to you not to overlap the RH end. Note that each selection is
  166. ' followed by a number and an uppercase letter. The number represents the
  167. ' POSITION in the preceding selection of the 'quick key' you want to
  168. ' highlight. The uppercase letter is the index to the help page you want
  169. ' Pophelp to display if the user presses F1 while the menu is open.
  170. ' Each group of menu selections must end with ,#/
  171.  
  172.   DATA "Stars   ",1,C,"Constellations   ",1,C,"Planets   ",1,C
  173.   DATA "Signs                              ",2,C,Help,1,C,#
  174.  
  175. '/Submenu selections/
  176. '/Do not use any leading/trailing spaces in sub menu selections. If you
  177. ' want to place horizontal dividers in any submenu then code *,0,Z, in the
  178. ' positions you want (see 'Earth' in the 3rd. set of DATA statements below).
  179. ' Don't forget that a horizontal divider counts as one selection when you
  180. ' are totalling selections for the purposes of DIMensioning menu$() etc.
  181. ' Submenu selection lists must also end with ,#/
  182.  
  183.   DATA Arcturus,1,D,Betelgeuse,1,D,Sirius,1,D,Aldebaran,3,D
  184.   DATA Formalhaut,1,D,Canopus,1,D,Zubenelgenubi,1,D,#
  185.  
  186.   DATA Canis Major,1,D,Cassiopeia,7,D,Andromeda,1,D
  187.   DATA Ursa Minor,1,D,Corona Borealis,8,D,#
  188.  
  189.   DATA Mercury,3,D,Venus,1,D,*,0,Z,Earth,1,D,*,0,Z,Mars,1,D
  190.   DATA Jupiter,1,D,Saturn,1,D,Uranus,1,D,Neptune,1,D,Pluto,1,D,#
  191.  
  192.   DATA Capricorn,1,D,Aquarius,1,D,Pisces,1,D,Aries,2,D,Taurus,1,D,Gemini,1,D
  193.   DATA Cancer,3,D,Leo,1,D,Virgo,1,D,Libra,2,D,Scorpio,3,D,Sagittarius,1,D,#
  194.  
  195.   DATA Call POPHELP Index,14,D,#
  196.                                    
  197. END
  198.  
  199. SUB Monocheck STATIC
  200. SHARED spectrum()
  201.  
  202.   COLOR 7, 0
  203.   CLS
  204.   LOCATE 2, 3
  205.   PRINT "Press <C> for Colour"
  206.   LOCATE 3, 3
  207.   PRINT "Press <M> for Monochrome"
  208.  
  209.   DO
  210.     sel$ = INKEY$
  211.     IF UCASE$(sel$) = "C" THEN
  212.  
  213. '/Allocate menu colours/
  214.  
  215.       spectrum(0) = 14    '/highlighted letters (quick keys)/
  216.       spectrum(1) = 10    '/menu border/
  217.       spectrum(2) = 11    '/menu text/
  218.       spectrum(3) = 4     '/menu background/
  219.       spectrum(4) = 10    '/selected entries text/
  220.       spectrum(5) = 0     '/selected entries background/
  221.  
  222. '/allocate Pophelp colours/
  223.  
  224.       spectrum(8) = 14      '/page text/
  225.       spectrum(9) = 1       '/background/
  226.       spectrum(10) = 10     '/border/
  227.       spectrum(11) = 15     '/border text/
  228.  
  229. '/other colours needed for program/
  230.  
  231.       spectrum(12) = 2      '/screen backgound colour/
  232.       spectrum(13) = 0      '/prompt line foreground/
  233.       spectrum(14) = 7      '/prompt line background/
  234.       EXIT DO
  235.  
  236.     ELSEIF UCASE$(sel$) = "M" THEN
  237.  
  238. '/not colour so set for mono monitor/
  239.  
  240.       spectrum(0) = 15
  241.       spectrum(1) = 0
  242.       spectrum(2) = 0
  243.       spectrum(3) = 7
  244.       spectrum(4) = 15
  245.       spectrum(5) = 0
  246.       spectrum(6) = 0
  247.       spectrum(8) = 0
  248.       spectrum(9) = 7
  249.       spectrum(10) = 0
  250.       spectrum(11) = 15
  251.       spectrum(12) = 0
  252.       spectrum(13) = 0
  253.       spectrum(14) = 7
  254.       EXIT DO
  255.  
  256.     END IF
  257.   LOOP
  258.  
  259. END SUB
  260.  
  261.